VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsWriteXML"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Function WriteXML(ByVal nReqSeqNum As String, ByVal nTypeResponse As String, ByRef nNewMessageID As String, _
                         ByVal nComId As String, ByVal nBuId As String, ByVal nReferenceId As String) As String

    Dim xmldoc                  As MSXML2.DOMDocument
    Dim ProcessInst             As MSXML2.IXMLDOMProcessingInstruction
    Dim nRootElement            As MSXML2.IXMLDOMNode
    
    Dim nRequestor              As MSXML2.IXMLDOMNode
    Dim nTracking               As MSXML2.IXMLDOMNode
    Dim nResponse               As MSXML2.IXMLDOMNode
    
    Dim nlRequestor             As MSXML2.IXMLDOMNodeList
    Dim nlTracking              As MSXML2.IXMLDOMNodeList
    Dim nlResponse              As MSXML2.IXMLDOMNodeList
    
    'Requestor
    Dim ellDate                 As MSXML2.IXMLDOMElement
    Dim ellTime                 As MSXML2.IXMLDOMElement
    Dim ellName                 As MSXML2.IXMLDOMElement
    Dim ellUserID               As MSXML2.IXMLDOMElement
    Dim ellemail                As MSXML2.IXMLDOMElement
    
    'Tracking
    Dim ellRequestStatus        As MSXML2.IXMLDOMElement
    Dim ellCompany              As MSXML2.IXMLDOMElement
    Dim ellBusinessUnit         As MSXML2.IXMLDOMElement
    Dim ellMessage              As MSXML2.IXMLDOMElement
    Dim ellReference            As MSXML2.IXMLDOMElement
    Dim ellKeytaxRequestNumber  As MSXML2.IXMLDOMElement
    Dim ellKeytax               As MSXML2.IXMLDOMElement
    
    
    
    On Error GoTo PROC_ERROR
    
    'barb:
    'Set xmldoc = New MSXML2.DOMDocument
    Set xmldoc = New MSXML2.DOMDocument
    
    Set ProcessInst = xmldoc.createProcessingInstruction("xml", "version='1.0'")
    Set nRootElement = xmldoc.createNode(NODE_ELEMENT, "KeyTax", "")
    Set ellKeytax = nRootElement
    Call ellKeytax.setAttribute("Type", nTypeResponse)
    Set xmldoc.documentElement = nRootElement
    
    
    'First Node - Requestor details
    Set nRequestor = xmldoc.createElement("Requestor")
    Call nRootElement.appendChild(nRequestor)
    
    Set ellDate = xmldoc.createElement("Date")
    Call ConvertDate(dtDate)
    ellDate.nodeTypedValue = dtDate
    Call nRequestor.appendChild(ellDate)
    
    Set ellTime = xmldoc.createElement("Time")
    ellTime.nodeTypedValue = dtTime
    Call nRequestor.appendChild(ellTime)
    
    Set ellName = xmldoc.createElement("Name")
    ellName.nodeTypedValue = sName
    Call nRequestor.appendChild(ellName)
    
    Set ellUserID = xmldoc.createElement("UserID")
    ellUserID.nodeTypedValue = strUser
    Call nRequestor.appendChild(ellUserID)
    
    Set ellemail = xmldoc.createElement("email")
    ellemail.nodeTypedValue = sEmailTo
    Call nRequestor.appendChild(ellemail)
    
    
    'Second Node - Tracking details
    Set nTracking = xmldoc.createElement("Tracking")
    Call nRootElement.appendChild(nTracking)
    
    'Can be either 07=approved, 08=declined etc
    Set ellRequestStatus = xmldoc.createElement("RequestStatus")
    ellRequestStatus.nodeTypedValue = nTypeStatus
    Call nTracking.appendChild(ellRequestStatus)
    
    Set ellCompany = xmldoc.createElement("Company")
    Call ellCompany.setAttribute("ID", nComId)
    Call nTracking.appendChild(ellCompany)
    
    Set ellBusinessUnit = xmldoc.createElement("BusinessUnit")
    Call ellBusinessUnit.setAttribute("ID", nBuId)
    Call nTracking.appendChild(ellBusinessUnit)
    
    'Generated through clsMsgID. Not passed through parameters
    Set ellMessage = xmldoc.createElement("Message")
    Dim dllNewID As clsMsgID
    Set dllNewID = New clsMsgID
    dllNewID.GetNextKtMessageId nNewMessageID
    Call ellMessage.setAttribute("ID", nNewMessageID)
    Call nTracking.appendChild(ellMessage)
    
    Set ellReference = xmldoc.createElement("Reference")
    Call ellReference.setAttribute("ID", nReferenceId)
    Call nTracking.appendChild(ellReference)
    
    Set ellKeytaxRequestNumber = xmldoc.createElement("KeytaxRequestNumber")
    ellKeytaxRequestNumber.nodeTypedValue = nReqSeqNum
    Call nTracking.appendChild(ellKeytaxRequestNumber)
    
    'xmldoc.Save ("C:\Shane\Projects\LCB\FormB\XML Docs\HeaderTemp\Header_Response.xml")
    
    WriteXML = CStr(xmldoc.xml)
    
'clean up
Set xmldoc = Nothing
Set ProcessInst = Nothing
Set nRootElement = Nothing

Set nRequestor = Nothing
Set nTracking = Nothing
Set nResponse = Nothing

Set nlRequestor = Nothing
Set nlTracking = Nothing
Set nlResponse = Nothing

'Requestor
Set ellDate = Nothing
Set ellTime = Nothing
Set ellName = Nothing
Set ellUserID = Nothing
Set ellemail = Nothing

'Tracking
Set ellRequestStatus = Nothing
Set ellCompany = Nothing
Set ellBusinessUnit = Nothing
Set ellMessage = Nothing
Set ellReference = Nothing
Set ellKeytaxRequestNumber = Nothing
Set ellKeytax = Nothing
    
PROC_EXIT:
  Exit Function

PROC_ERROR:
  Err.Raise Err.Number, _
            "clsWriteXML/WriteXML", _
            Err.Description
  Resume PROC_EXIT
    
    
End Function
Public Function ConvertDate(ByRef dtDate As String)
'2002-01-22
Dim dtYear As String
Dim dtMonth As String
Dim dtDay As String

dtYear = Left(dtDate, 4)
dtMonth = Mid(dtDate, 5, 2)
dtDay = Right(dtDate, 2)

dtDate = dtYear & dtMonth & dtDay

End Function

